home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1998 July / EnigmA AMIGA RUN 29 (1998)(G.R. Edizioni)(IT)[!][issue 1998-07 & 08].iso / recent / fw_gfx.lha / FW_GfxClip / GfxClip.fwrexx.long < prev    next >
Text File  |  1998-06-14  |  13KB  |  414 lines
  1. /* ================================    */
  2. /*  FINAL WRITER AREXX MACRO            */
  3. /*  Graphics Clip Macro Generator.    */
  4. /* $VER: GfxMacroGen 3.1 (21.9.94)    */
  5. /* ================================    */
  6. /* rewritten by: Heiko Schröder     */
  7. /*                   4.1 (13.6.98)  */
  8. /* ================================    */
  9.  
  10. Options results
  11. call addlib('rexxreqtools.library',5,-30)
  12.  
  13. Address='FinalW'
  14. STATUS PORTNAME
  15. FW = result
  16. address = FW
  17.  
  18. SIGNAL ON BREAK_C
  19.  
  20. Call Open("sprache","env:language","R")
  21.    language=readln("sprache")
  22. Call Close ("sprache")
  23.  
  24. /*Languages*/
  25. If language="deutsch" then do
  26.    t0='"Gfx Clip 4.1 - Makro Generator" "© 1994 Softwood" "& 1998 Heiko Schröder" "Weiter" "Abbrechen" ""'
  27.    t1='"Keine Grafik ausgewählt." "Die Vorlage kann nicht erstellt werden." "" "Achso" "" ""'
  28.    t2="GFX Clip - Speichern unter"
  29.    t21="Speichern"
  30.    t3='"Sie haben keinen Dateinamen eingegeben." "Die Vorlage kann nicht erstellt werden." "" "Achso" "" ""'
  31.    t4='"Dateifehler!" "" "" "Oje" "" ""'
  32. End
  33. Else do
  34.    t0='"Gfx Clip 4.1 - Macro Generator" "© 1994 Softwood" "& 1998 Heiko Schröder" "Continue" "Cancel" ""'
  35.    t1 ='"No object selected." "The template could not be created." "" "Okay" "" ""'
  36.    t2="GFX Clip - Save As"
  37.    t21="Save"
  38.    t3 ='"You have not entered a valid filename." "The template could not be created." "" "Okay" "" ""'
  39.    t4 ='"File error!" "" "" "Oops" "" ""'
  40. End
  41.  
  42. ShowMessage 1 1 t0
  43. IF ( Result = 2 ) THEN EXIT
  44.  
  45. SetMeasure RULER
  46. GetDocItemPrefs Decimal
  47. Punkt=Result
  48. If Punkt="Comma" then DocItemPrefs Decimal Period
  49.  
  50. Do While 1
  51.  
  52.    /* Get a list of all the selected objects. */
  53.    i = 0
  54.      Object.0 = 0
  55.    objtype.0 = 0
  56.    FirstObject SELECTED
  57.    IF ( Result = 0 ) THEN DO
  58.        ShowMessage 1 1 t1
  59.        Call SEnd
  60.     END
  61.  
  62.    DO WHILE ( Result ~= 0 )
  63.        i = i + 1
  64.        Object.i = Result
  65.        NextObject Object.i SELECTED
  66.    END
  67.  
  68.    /* Ungroup groups */
  69.    gruppe = false
  70.    Do a = 1 to i
  71.         GetObjectType Object.a
  72.         objtype.a = Result
  73.  
  74.       If objtype.a = 8 then do
  75.          SelectObject Object.a
  76.          gruppe = true
  77.          Ungroup
  78.  
  79.          FirstObject SELECTED
  80.          DO WHILE ( Result ~= 0 )
  81.              i = i + 1
  82.              Object.i = Result
  83.              NextObject Object.i SELECTED
  84.  
  85.          END
  86.       End
  87.    End
  88.  
  89.    If gruppe = true then do
  90.       SelectObject Object.1
  91.       Do a = 2 to i
  92.          SelectObject Object.a MULTIPLE
  93.       End
  94.    End
  95.    else leave
  96. End
  97.  
  98. /* Get a filename to use */
  99. If GetClip("GFX-DIR")="" Then dir="FWMacros/"
  100.    Else dir=GetClip("GFX-DIR")
  101.  
  102. p=max(index(dir,':'),lastpos('/',dir))
  103. file=delstr(dir,1,p)
  104. dir=substr(dir,1,p)
  105. filename = rtfilerequest(dir,file,t2,t21,"rt_screentofront=true" "rt_pubscrname=FinalWriterPubScreen")
  106.  
  107. /* Make sure a filename is entered */
  108. if filename="" then DO
  109.     ShowMessage 1 1 t3
  110.      Call SEnd
  111. END
  112.  
  113. void=SetClip("GFX-DIR",strip(filename,B,'"'))
  114.  
  115. /* Does the file already exist? */
  116. IF    EXISTS(filename) THEN DO
  117.    IF language="deutsch" then
  118.        t5 = '"Das Template <' || filename || '> existiert bereits." "Möchten Sie es überschreiben?" "" "Ja" "Nein" ""'
  119.    Else
  120.        t5 = '"The Template <' || filename || '> already exists." "Would you like to overwrite it?" "" "Yes" "No" ""'
  121.    
  122.     ShowMessage 2 1 t5
  123.     IF ( Result = 2 ) THEN Call SEnd
  124. END
  125.  
  126. /* What is the page height we are working with? */
  127. GetPageSetup HEIGHT
  128. pageHt = Result
  129.  
  130. /* Open the file. */
  131. IF ( OPEN('GfxClipFile', filename, 'Write')~=1 ) THEN DO
  132.  
  133.     /* File could not be opened. */
  134.    IF language="deutsch" then
  135.        t6 = '"Datei <' || filename || '> kann nicht geöffnet werden." "" "" "Oje" "" ""'
  136.    Else 
  137.        t6 = '"File <' || filename || '> could not be opened." "" "" "Ok" "" ""'
  138.     ShowMessage 1 1 t6
  139.    Call SEnd
  140. END
  141.  
  142. /* File is opened. */
  143.  
  144. /* Write the file header stuff */
  145. CALL LineOut('GfxClipFile', '/* ------------------------ */')
  146. CALL LineOut('GfxClipFile', '/* Final Writer Arexx Macro */')
  147. CALL LineOut('GfxClipFile', '/* created on' date() '  */')
  148. CALL LineOut('GfxClipFile', '/* with GfxClip 4.1         */')
  149. CALL LineOut('GfxClipFile', '/* © Softwood / H. Schröder */')
  150. CALL LineOut('GfxClipFile', '/* ------------------------ */')
  151. CALL LineOut('GfxClipFile', '')
  152. CALL LineOut('GfxClipFile', 'Options Results')
  153. CALL LineOut('GfxClipFile', 'SetMeasure RULER')
  154. CALL LineOut('GfxClipFile', 'GetDocItemPrefs Decimal')
  155. CALL LineOut('GfxClipFile', 'Punkt=Result')
  156. CALL LineOut('GfxClipFile', 'If Punkt="Comma" then DocItemPrefs Decimal Period')
  157. CALL LineOut('GfxClipFile', 'Status PAGE')
  158. CALL LineOut('GfxClipFile', 'page1=result+1')
  159. CALL LineOut('GfxClipFile', 'GetSectionSetup FirstPage')
  160. CALL LineOut('GfxClipFile', 'page2=result')
  161. CALL LineOut('GfxClipFile', 'page=page1-page2')
  162. CALL LineOut('GfxClipFile', 'numobjs = 0')
  163. CALL LineOut('GfxClipFile', '')
  164.  
  165.  
  166. /* -----------------------------------------------    */
  167. /* For each object, determine the coordinates and    */
  168. /* find the minimum x and y values to use to            */
  169. /* normalize the coordinatess.                            */
  170. /* -----------------------------------------------    */
  171. x = 0
  172. DO WHILE ( x < i )
  173.     x = x + 1
  174.  
  175.     /* Before getting the coordinates un-rotate the object */
  176.     GetObjectRotation Object.x
  177.     objRotate.x = Result
  178.     IF ( objRotate.x ~= 0 ) THEN
  179.         SetObjectRotation Object.x 0
  180.  
  181.     /* Get the coordinates */
  182.     GetObjectCoords Object.x
  183.     PARSE VAR Result page.x x1.x y1.x x2.x y2.x
  184.  
  185.     /* If we un-rotated the object, rotate it back. */
  186.     IF    ( objRotate.x ~= 0 ) THEN
  187.         SetObjectRotation Object.x objRotate.x
  188. END
  189.  
  190. /* For each one of the graphic objects in our list */
  191. /* create AREXX code to redraw the object.            */
  192. x = 0
  193. DO WHILE ( x < i )
  194.     x = x + 1
  195.  
  196.     SELECT
  197.         WHEN (objtype.x = 2 | objtype.x = 3) THEN DO
  198.             /* -------------- */
  199.             /* We have a Line */
  200.             /* -------------- */
  201.             modifier = ""
  202.             if    ( objtype.x = 3 ) THEN
  203.                 modifier = 'ARROW'
  204.  
  205.             /* Output the commands to calculate line's position. */
  206.             commandLine = 'fromX =' x1.x ''
  207.             CALL LineOut('GfxClipFile', commandline)
  208.             commandLine = 'toX =' x2.x ''
  209.             CALL LineOut('GfxClipFile', commandline)
  210.  
  211.             commandLine = 'fromY =' y1.x ''
  212.             CALL LineOut('GfxClipFile', commandline)
  213.             commandLine = 'toY =' y2.x ''
  214.             CALL LineOut('GfxClipFile', commandline)
  215.  
  216.             /* Output the commands to draw the line. */
  217.             commandLine = 'DrawLine page fromX fromY toX toY' modifier
  218.             CALL LineOut('GfxClipFile', commandLine)
  219.             CALL LineOut('GfxClipFile', 'objectid.numobjs = Result')
  220.             CALL LineOut('GfxClipFile', 'numobjs = numobjs + 1');
  221.  
  222.             /* Output the commands to set the line's parameters. */
  223.             GetObjectParams Object.x TEXTFLOW FLOWDIST LINEWT
  224.             PARSE VAR Result tf fd lw
  225.             commandLine = 'SetObjectParams 0' 'TEXTFLOW' tf 'FLOWDIST' fd 'LINEWT' lw
  226.             CALL LineOut('GfxClipFile', commandLine)
  227.  
  228.             /* The line color may contain spaces, so treat it separately. */
  229.             GetObjectParams Object.x LINECOLOR
  230.             commandLine = 'SetObjectParams 0'  'LINECOLOR' "'" || '"' || Result || '"' || "'"
  231.             CALL LineOut('GfxClipFile', commandLine)
  232.         END
  233.  
  234.         WHEN (objtype.x = 4 | objtype.x = 5) THEN DO
  235.             /* ------------- */
  236.             /* We have a Box */
  237.             /* ------------- */
  238.             modifier = ""
  239.             if (objtype.x = 5) THEN
  240.                 modifier = 'BEVEL'
  241.  
  242.             /* Output the command to draw the box. */
  243.             commandLine = 'newX =' x1.x ''
  244.             CALL LineOut('GfxClipFile', commandline)
  245.             commandLine = 'newY =' y1.x ''
  246.             CALL LineOut('GfxClipFile', commandline)
  247.  
  248.             commandLine = 'DrawBox page newX newY' x2.x y2.x modifier
  249.             CALL LineOut('GfxClipFile', commandLine)
  250.             CALL LineOut('GfxClipFile', 'objectid.numobjs = Result');
  251.             CALL LineOut('GfxClipFile', 'numobjs = numobjs + 1');
  252.  
  253.             /* Output the commands to set the box's parameters. */
  254.             GetObjectParams Object.x TEXTFLOW FLOWDIST LINEWT FILL
  255.             PARSE VAR Result tf fd lw fl
  256.             commandLine = 'SetObjectParams 0' 'TEXTFLOW' tf 'FLOWDIST' fd 'LINEWT' lw 'FILL' fl
  257.             CALL LineOut('GfxClipFile', commandLine)
  258.  
  259.             /* The line and fill colors may contain spaces, so treat them separately. */
  260.             GetObjectParams Object.x LINECOLOR
  261.             commandLine = 'SetObjectParams 0'  'LINECOLOR' "'" || '"' || Result || '"' || "'"
  262.             CALL LineOut('GfxClipFile', commandLine)
  263.  
  264.             GetObjectParams Object.x FILLCOLOR
  265.             commandLine = 'SetObjectParams 0'  'FILLCOLOR' "'" || '"' || Result || '"' || "'"
  266.             CALL LineOut('GfxClipFile', commandLine)
  267.         END
  268.  
  269.         WHEN (objtype.x = 6 | objtype.x = 9) THEN DO
  270.             /* ------------------------- */
  271.             /* We have an Oval or an Arc */
  272.             /* ------------------------- */
  273.             modifier = ""
  274.             if (objtype.x = 9) THEN
  275.                 modifier = 'ARC'
  276.  
  277.             /* Output the command to draw the oval. */
  278.             commandLine = 'newX =' x1.x ''
  279.             CALL LineOut('GfxClipFile', commandline)
  280.             commandLine = 'newY =' y1.x ''
  281.             CALL LineOut('GfxClipFile', commandline)
  282.  
  283.             commandLine = 'DrawOval page newX newY' x2.x y2.x modifier
  284.             CALL LineOut('GfxClipFile', commandLine)
  285.             CALL LineOut('GfxClipFile', 'objectid.numobjs = Result');
  286.             CALL LineOut('GfxClipFile', 'numobjs = numobjs + 1');
  287.  
  288.             /* Output the commands to set the oval's parameters. */
  289.             GetObjectParams Object.x TEXTFLOW FLOWDIST LINEWT FILL
  290.             PARSE VAR Result tf fd lw fl
  291.             commandLine = 'SetObjectParams 0' 'TEXTFLOW' tf 'FLOWDIST' fd 'LINEWT' lw 'FILL' fl
  292.             CALL LineOut('GfxClipFile', commandLine)
  293.  
  294.             /* The line and fill colors may contain spaces, so treat them separately. */
  295.             GetObjectParams Object.x LINECOLOR
  296.             commandLine = 'SetObjectParams 0' 'LINECOLOR' "'" || '"' || Result || '"' || "'"
  297.             CALL LineOut('GfxClipFile', commandLine)
  298.  
  299.             GetObjectParams Object.x FILLCOLOR
  300.             commandLine = 'SetObjectParams 0' 'FILLCOLOR' "'" || '"' || Result || '"' || "'"
  301.             CALL LineOut('GfxClipFile', commandLine)
  302.         END
  303.  
  304.         WHEN (objtype.x = 7) THEN DO
  305.             /* ------------------- */
  306.             /* We have a TextBlock */
  307.             /* ------------------- */
  308.  
  309.             /* Output the command to draw the textblock. */
  310.             commandLine = 'newX =' x1.x ''
  311.             CALL LineOut('GfxClipFile', commandline)
  312.             commandLine = 'newY =' y1.x ''
  313.             CALL LineOut('GfxClipFile', commandline)
  314.  
  315.             GetTextBlockText Object.x
  316.             text = Result
  317.             commandLine = 'DrawTextBlock page newX newY' '"' || text || '"'
  318.             CALL LineOut('GfxClipFile', commandLine)
  319.             CALL LineOut('GfxClipFile', 'objectid.numobjs = Result');
  320.             CALL LineOut('GfxClipFile', 'numobjs = numobjs + 1');
  321.  
  322.             /* Output the commands to set the textblock's parameters. */
  323.             GetObjectParams Object.x TEXTFLOW FLOWDIST
  324.             PARSE VAR Result tf fd
  325.             commandLine = 'SetObjectParams 0' 'TEXTFLOW' tf 'FLOWDIST' fd
  326.             CALL LineOut('GfxClipFile', commandLine)
  327.  
  328.             /* Output the commands to set the textblock's typespecs. */
  329.             GetObjectTypeSpecs Object.x SIZE LEADING WIDTH OBLIQUE
  330.             PARSE VAR Result sz ld wd ob
  331.             commandLine = 'SetObjectTypeSpecs 0' 'SIZE' sz 'LEADING' ld 'WIDTH' wd 'OBLIQUE' ob
  332.             CALL LineOut('GfxClipFile', commandLine)
  333.  
  334.             /* The color and font may contain spaces, so treat them separately. */
  335.             GetObjectTypeSpecs Object.x COLOR
  336.             commandLine = 'SetObjectTypeSpecs 0' 'COLOR' "'" || '"' || Result || '"' || "'"
  337.             CALL LineOut('GfxClipFile', commandLine)
  338.  
  339.             GetObjectTypeSpecs Object.x FONT
  340.             commandLine = 'SetObjectTypeSpecs 0' 'FONT' '"' || Result || '"'
  341.             CALL LineOut('GfxClipFile', commandLine)
  342.         END
  343.  
  344.         OTHERWISE ITERATE        /* Ignore images (objtype.x = 1), groups (objtype.x = 8),*/
  345.                                         /* draw class objects (objtype = 10)                            */
  346.                                         /* and anything else we don't recognize.                 */
  347.     END /* End select */
  348.  
  349.     /* Output command to rotate the object if needed */
  350.     IF    ( objRotate.x ~= 0 ) THEN DO
  351.         commandLine = 'SetObjectRotation 0' objRotate.x
  352.         CALL LineOut('GfxClipFile', commandLine)
  353.     END
  354.  
  355.     /* Output the command to set the objects title. */
  356.     GetObjectTitle object.x
  357.     commandLine = 'SetObjectTitle 0' '"' || Result || '"'
  358.     CALL LineOut('GfxClipFile', commandLine)
  359.  
  360.     /* Output a blank line */
  361.     CALL LineOut('GfxClipFile', '')
  362.  
  363. END /* End while */
  364.  
  365. /* Output commands to select all the new objects. */
  366. CALL LineOut('GfxClipFile', 'i = 0')
  367. CALL LineOut('GfxClipFile', 'DO WHILE (i < numobjs)')
  368. CALL LineOut('GfxClipFile', 'SelectObject objectid.i MULTIPLE')
  369. CALL LineOut('GfxClipFile', 'i = i + 1')
  370. CALL LineOut('GfxClipFile', 'END')
  371. CALL LineOut('GfxClipFile', '')
  372.  
  373. /* Output the command to redraw everything. */
  374. CALL LineOut('GfxClipFile', 'Redraw')
  375. CALL LineOUt('GfxClipFile', 'GraphicTool')
  376. CALL LineOut('GfxClipFile', '')
  377.  
  378. CALL LineOut('GfxClipFile', 'If Punkt="Comma" then DocItemPrefs DECIMAL Comma')
  379. /* Close the file */
  380. CALL CLOSE('GfxClipFile');
  381.  
  382. /* Reselect all of our objects */
  383. x = 0
  384. DO WHILE ( x < i )
  385.     X = X + 1
  386.    SelectObject Object.x MULTIPLE
  387. END
  388.  
  389. Call SEnd
  390.  
  391.  
  392. /* ============================================ */
  393. /* LineOut                                      */
  394. /* Procedure to write a line out to the file    */
  395. /* checking for errors and exiting if any found */
  396. /* ============================================ */
  397. LineOut: PROCEDURE
  398. PARSE ARG filehandle, str
  399.  
  400.     len = WRITELN( filehandle, str )
  401.     IF (len ~= LENGTH(str) + 1) THEN DO
  402.         ShowMessage 1 1 t4
  403.         CALL CLOSE(filehandle);
  404.         EXIT
  405.         END
  406.  
  407. RETURN
  408.  
  409.  
  410. SEnd:
  411.    If Punkt="Comma" then DocItemPrefs DECIMAL Comma
  412.    Exit
  413. RETURN
  414.